home *** CD-ROM | disk | FTP | other *** search
/ EnigmA Amiga Run 1997 April / EnigmA AMIGA RUN 17 (1997)(G.R. Edizioni)(IT)[!][issue 1997-04][EAR-CD].iso / EARCD / text / print / Video_Label.lha / Video-Label / video-label.b < prev    next >
Text File  |  1996-12-07  |  9KB  |  301 lines
  1. REM Spezielle Version zur Compilierung mit ACE 2.35
  2. REM Kein Standard Basic !
  3. WINDOW 1,"Video-Label V1.6 ; - Compiled with ACE 2.35 -",(1,1)-(639,199),24
  4. DEFINT a-z
  5. PALETTE 1,0,0,0
  6. PALETTE 0,.75,.75,.75
  7. REM PALETTE 2,.3,.3,.3
  8. REM PALETTE 3,.25,.6,.6
  9. LET d%=0:LET band%=240:LET n%=0:LET nummer%=0:DIM movie$(4):DIM laenge$(4)
  10. nn$="":vn$=""
  11. x%=10:y%=110
  12. Namen:
  13. CLS:LOCATE 3,3:PRINT "WILLKOMMEN BEI VIDEO-LABEL !!!"
  14. nn$=INPUTBOX$ ("Nachname: (max. 10 Zeichen) : ",,nn$,x%,y%)
  15. IF LEN(nn$)>10 THEN 
  16.  GOTO Namen
  17. END IF
  18. VNamen: 
  19. LOCATE 4,3:vn$=INPUTBOX$ ("Vorname: (max. 10 Zeichen ) : ",,vn$,x%,y%)
  20. IF LEN(vn$)>10 THEN 
  21.  GOTO VNamen
  22. END IF
  23. ok: 
  24. CLS:LOCATE 10,10:PRINT "Sie heißen: ";vn$;" ";nn$
  25. jn=MSGBOX ("Sind die Eingaben korrekt ?","Ja","Nein")
  26. IF jn=-1 THEN GOTO anfang
  27. GOTO Namen 
  28. anfang:
  29. CLS:GOSUB info
  30. filme:
  31. LET j%=0:LET anz%=5:LET grenze1%=37 'Länge der Zeichenkette für die Filme
  32. laenge$(0)="":laenge$(1)=":":laenge$(2)=":":laenge$(3)=":":laenge$(4)=":"
  33. movie$(0)="":movie$(1)="":movie$(2)="":movie$(3)="":movie$(4)=""
  34. y%=110
  35. x%=10
  36. LOCATE 9,4:anz%=INPUTBOX ("Anzahl der Filme (Max. 4) ? ","Anzahl der Filme","2",x%,y%)
  37. IF anz%<1 OR anz%>4 THEN 
  38.  GOTO filme
  39. END IF
  40. initialisierung:
  41. IF anz%>0 THEN
  42. f1f: 
  43.   movie$(1)=INPUTBOX$("Film 1 eingeben :",,movie$(1),x%,y%)
  44.   IF LEN(movie$(1))=0 THEN GOTO f1f
  45. f1l:
  46.   laenge$(1)=INPUTBOX$("Länge Film 1 z.B 01:34 :",,laenge$(1),x%,y%)
  47.   IF LEN(laenge$(1))<5 OR LEN(laenge$(1))>5 THEN GOTO f1l
  48. END IF
  49. IF anz%>1 THEN
  50. f2f:
  51.   movie$(2)=INPUTBOX$("Film 2 eingeben : ",,movie$(2),x%,y%)
  52.   IF LEN(movie$(2))=0 THEN GOTO f2f
  53. f2l:
  54.   laenge$(2)=INPUTBOX$("Länge Film 2 z.B. 01:44 :",,laenge$(2),x%,y%)
  55.   IF LEN(laenge$(2))<5 OR LEN(laenge$(3))>5 THEN GOTO f2l
  56. END IF
  57. IF anz%>2 THEN
  58. f3f:
  59.   movie$(3)=INPUTBOX$("Film 3 eingeben : ",,movie$(3),x%,y%)
  60.   IF LEN(movie$(3))=0 THEN GOTO f3f
  61. f3l:
  62.   laenge$(3)=INPUTBOX$("Länge Film 3 z.B. 01:56 :",,laenge$(3),x%,y%)
  63.   IF LEN(laenge$(3))<5 OR LEN(laenge$(3))>5 THEN GOTO f3l
  64. END IF
  65. IF anz%>3 THEN
  66. f4f:
  67.   movie$(4)=INPUTBOX$("Film 4 eingeben : ",,movie$(4),x%,y%)
  68.   IF LEN(movie$(4))=0 THEN GOTO f4f
  69. f4l: laenge$(4)=INPUTBOX$("Länge Film 4 z.B. 01:56 : ",,laenge$(4),x%,y%)
  70.   IF LEN(laenge$(4))<5 OR LEN(laenge$(4))>5 THEN GOTO f4l
  71. END IF
  72. abfragefilme:
  73. filmin:
  74. FOR i=1 TO anz%
  75. IF LEN(movie$(i))>grenze1% THEN movie$(i)=LEFT$(movie$(i),grenze1%-4)+" ..."
  76. NEXT i
  77. abfragekass:
  78. LOCATE 10+anz%*2,4:band%=INPUTBOX ("Kassettenlänge eingeben : ",,"240",x%,y%)
  79. IF band%=0 THEN 
  80.  band%=240
  81. END IF
  82. IF band%=240 OR band%=200 OR band%=30 OR band%=60 OR band%=120 OR band%=180 OR band%=195 OR band%=210 OR band%=300 THEN 
  83.  GOTO abfragekassnr
  84. END IF
  85. GOTO abfragekass
  86. abfragekassnr:
  87. LOCATE 11+anz%*2,4:n%=INPUTBOX ("Kassettennummer eingeben :",,,x%,y%)
  88. n%=CLNG(n%)
  89. IF n%=0 THEN 
  90.  nummer%=nummer%+1:GOSUB num:GOTO abfrage
  91. END IF
  92. IF n%>0 AND n%<=999 THEN 
  93.  nummer%=n%:GOSUB num:GOTO abfrage
  94. END IF
  95. GOTO abfragekassnr
  96. abfrage: 
  97. CLS:GOSUB info
  98. datenzeigen:
  99. PRINT :PRINT "Filme:"
  100. FOR i=1 TO anz%
  101. PRINT movie$(i)+" ->"+laenge$(i)
  102. NEXT i
  103. PRINT "Band: "band%
  104. PRINT "Kassnr: "nummer%
  105. LINE (389,70)-(610,104),1,b
  106. LOCATE 10,50:PRINT " 0 oder <RETURN> für Weiter"
  107. LOCATE 11,50:PRINT " 1 bis"anz%"für die Filme"
  108. LOCATE 12,50:PRINT "-1 für Bandänderung"
  109. LOCATE 13,50:PRINT "-2 für Nummernänderung"
  110. LOCATE 19,1:INPUT"Nummer eingeben : ",j% 
  111. PRINT
  112. IF j%=0 THEN 
  113.  GOTO GoOn 
  114. END IF
  115. IF j%=-1 THEN 
  116.  GOTO band1
  117. END IF
  118. IF j%=-2 THEN 
  119.  GOTO nummer1
  120. END IF
  121. IF j%<-2 OR j%>anz% THEN 
  122.  GOTO abfrage
  123. END IF
  124. film: 
  125. IF j%=1 THEN
  126.  mov$=INPUTBOX$ ("* Film 1 eingeben : ",,movie$(1),x%,y%)
  127. END IF
  128. IF j%=2 THEN
  129.  mov$=INPUTBOX$ ("* Film 2 eingeben : ",,movie$(2),x%,y%)
  130. END IF
  131. IF j%=3 THEN
  132.  mov$=INPUTBOX$ ("* Film 3 eingeben : ",,movie$(3),x%,y%)
  133. END IF
  134. IF j%=4 THEN
  135.  mov$=INPUTBOX$ ("* Film 4 eingeben : ",,movie$(4),x%,y%)
  136. END IF
  137. IF LEN(mov$)>grenze1% THEN mov$=LEFT$(mov$,grenze1%-4)+" ..."
  138. IF LEN(mov$)=0 THEN 
  139.  GOTO long
  140. END IF
  141. movie$(j%)=mov$
  142. mov$=""
  143. long:
  144. IF j%=1 THEN 
  145.  long$=INPUTBOX$("* Länge Film 1 eingeben : ",,laenge$(1),x%,y%)
  146. END IF
  147. IF j%=2 THEN
  148.  long$=INPUTBOX$("* Länge Film 2 eingeben : ",,laenge$(2),x%,y%)
  149. END IF
  150. IF j%=3 THEN
  151.  long$=INPUTBOX$("* Länge Film 3 eingeben : ",,laenge$(3),x%,y%)
  152. END IF
  153. IF j%=4 THEN
  154.  long$=INPUTBOX$("* Länge Film 4 eingeben : ",,laenge$(4),x%,y%)
  155. END IF
  156. IF LEN(long$)=0 THEN 
  157.  GOTO abfrage
  158. END IF
  159. IF LEN(long$)<>5 THEN 
  160.  GOTO long
  161. END IF
  162. laenge$(j%)=long$:long$=""
  163. GOTO abfrage
  164. GoOn:
  165. ask=-1
  166. ask=MSGBOX("Drucken?","Ja! Drucken","Nein! Prg. beenden")
  167. IF ask=-1 THEN GOTO Drucken
  168. GOTO ende
  169. Drucken:
  170. GOSUB Druckerinit
  171. i1=0
  172. IF band%<100 THEN i1=1
  173. IF band%<9   then i1=2
  174. i2=0
  175. IF nummer%<100 THEN i2=1
  176. IF nummer%<10 THEN i2=2
  177. Beginnedruck:
  178.  fehler=1:msg$="Drucker-ERROR: Drucker Offline!"
  179.  status=PEEK(12570824&)
  180.  IF status=252 THEN fehler=0
  181.  IF status=254 THEN fehler=1:msg$="Drucker-ERROR: Papier aus!"
  182.  IF status=255 THEN fehler=1:msg$="Drucker-ERROR: Ausgeschaltet!"
  183.  IF fehler=0 THEN 
  184.   GOTO Print 
  185.  ELSE
  186.   info=MSGBOX ( msg$,"Fehler beseitigt!")
  187.   GOTO Beginnedruck
  188.  END IF
  189. Print:
  190. OPEN "O",1,"PRT:" 
  191.   PRINT #1,init$;
  192.   PRINT #1,deutsch$+norm$+fettein$+elite$+letter$+normschrift$;
  193.   PRINT #1,Unterstreichenein$+STRING$(59,"=")+Unterstreichenaus$
  194.   IF anz%=1 THEN
  195.   PRINT #1,SPACE$(47)+vn$+SPACE$(12-LEN(vn$))+":"
  196.   PRINT #1," "+movie$(1)+SPC(38-LEN(movie$(1)));"->"+laenge$(1)+" "+nn$+SPC(12-LEN(nn$))+":"
  197.   PRINT #1,SPACE$(47)+"Typ E-";band%;SPC(i1+1)+":"
  198.   PRINT #1,Unterstreichenein$;
  199.   PRINT #1,SPACE$(47)+"Nr.:  ";nummer%;SPC(i2+1)+":";
  200.   PRINT #1,Unterstreichenaus$
  201.   PRINT #1,STRING$(59,"=")
  202.   END IF
  203.   IF anz%=2 THEN
  204.   PRINT #1,SPACE$(47)+vn$+SPACE$(12-LEN(vn$))+":"
  205.   PRINT #1," "+movie$(1)+SPC(38-LEN(movie$(1)));"->"+laenge$(1)+" "+nn$+SPC(12-LEN(nn$))+":"
  206.   PRINT #1," "+movie$(2)+SPC(38-LEN(movie$(2)));"->"+laenge$(2)+" "+"Typ E-";band%;SPC(i1+1)+":" 
  207.   PRINT #1,Unterstreichenein$;
  208.   PRINT #1,SPACE$(47)+"Nr.:  ";nummer%;SPC(i2+1)+":";
  209.   PRINT #1,Unterstreichenaus$
  210.   PRINT #1,STRING$(59,"=")
  211.   END IF
  212.   IF anz%=3 THEN
  213.   PRINT #1," "+movie$(1)+SPC(38-LEN(movie$(1)));"->"+laenge$(1)+" "+vn$+SPACE$(12-LEN(vn$))+":"
  214.   PRINT #1," "+movie$(2)+SPC(38-LEN(movie$(2)));"->"+laenge$(2)+" "+nn$+SPC(12-LEN(nn$))+":"
  215.   PRINT #1," "+movie$(3)+SPC(38-LEN(movie$(3)));"->"+laenge$(3)+" "+"Typ E-";band%;SPC(i1+1)+":"
  216.   PRINT #1,Unterstreichenein$;
  217.   PRINT #1,SPACE$(47)+"Nr.:  ";nummer%;SPC(i2+1)+":";
  218.   PRINT #1,Unterstreichenaus$
  219.   PRINT #1,STRING$(59,"=")
  220.   END IF
  221.   IF anz%=4 THEN
  222.   PRINT #1," "+movie$(1)+SPC(38-LEN(movie$(1)));"->"+laenge$(1)+" "+vn$+SPACE$(12-LEN(vn$))+":"
  223.   PRINT #1," "+movie$(2)+SPC(38-LEN(movie$(2)));"->"+laenge$(2)+" "+nn$+SPC(12-LEN(nn$))+":"
  224.   PRINT #1," "+movie$(3)+SPC(38-LEN(movie$(3)));"->"+laenge$(3)+" "+"Typ E-";band%;SPC(i1+1)+":"
  225.   PRINT #1,Unterstreichenein$;
  226.   PRINT #1," "+movie$(4)+SPC(38-LEN(movie$(4)));"->"+laenge$(4)+" "+"Nr.:  ";nummer%;SPC(i2+1)+":";
  227.   PRINT #1,Unterstreichenaus$
  228.   PRINT #1,STRING$(59,"=")
  229.   END IF
  230.   PRINT #1,reset$;
  231. CLOSE 1
  232. frage:
  233. CLS:
  234. LOCATE 9,7 :PRINT "Die Labels müssen wie folgt geschnitten werden:"
  235. LOCATE 10,7 :PRINT "An der Oberseite des Labels mit der Scherre an der unteren"
  236. LOCATE 11,7:PRINT "gestrichelten Linie entlang schneiden."
  237. LOCATE 12,7:PRINT "An der Unterseite des Labels mit der Scherre an der oberen"
  238. LOCATE 13,7:PRINT "gestrichelten Linie entlang schneiden."
  239. LOCATE 14,7:PRINT "Am rechten Rand entlang der fett gestrichenen"
  240. LOCATE 15,7:PRINT "Linie schneiden, so daß sie auf dem Label nicht"
  241. LOCATE 16,7:PRINT "sichtbar ist."
  242. LOCATE 18,7:PRINT "Das fertige Label auf die Videokassette kleben.  "
  243. LOCATE 20,7:PRINT "  Linie:    -----     <- an der Unterseite    :  entlang schneiden"
  244. LOCATE 21,7:PRINT "            -----     <- an der Oberseite     : <-"
  245. LOCATE 23,7:PRINT "- Druck ausgeführt ! -"
  246. ask=0
  247. ask=MSGBOX("Wollen Sie noch ein Label bearbeiten ?","Ja, bitte!","Prg. beenden")
  248. IF ask=-1 THEN 
  249.  GOTO anfang
  250. END IF
  251. ende: 
  252. WINDOW CLOSE 1:STOP
  253. info:
  254. LOCATE 2,1:a$="Video-Label-Maker V1.5":PRINT a$
  255. LOCATE 3,1:PRINT STRING$(LEN(a$),"=")
  256. LOCATE 5,1:PRINT "(C)opyright by A. Ranhart in 1996 "
  257. LOCATE 6,1:PRINT "Ich drucke nur die Vorderseiten der Kassetten!"
  258. LOCATE 7,1:PRINT "Die Filmtitel sollten max. 38 Zeichen lang sein, ansonsten werden sie"
  259. LOCATE 8,1:PRINT "autom. gekürzt ! Bitte geben Sie nun die Daten ein!"
  260. RETURN  
  261. band1: 
  262. LOCATE 19,1:band%=INPUTBOX("* Kassettenlänge eingeben : ",,"240",x%,y%)
  263. IF band%=0 THEN 
  264.  band%=240
  265. END IF
  266. IF band%=240 OR band%=200 OR band%=30 OR band%=60 OR band%=120 OR band%=180 OR band%=195 OR band%=210 OR band%=300 THEN 
  267.  GOTO abfrage
  268. END IF
  269. GOTO band1
  270. nummer1:
  271. LOCATE 19,1:n%=INPUTBOX("* Kassettennummer eingeben : ",,,x%,y%)
  272. n%=CLNG(n%)
  273. IF n%=0 THEN 
  274.  GOTO abfrage
  275. END IF
  276. IF n%>0 AND n%<=999 THEN 
  277.  nummer%=n%:GOTO abfrage
  278. END IF
  279. GOTO nummer1
  280. num:
  281. IF nummer%=1000 THEN 
  282.  nummer%=1
  283. END IF
  284. RETURN
  285. Druckerinit:
  286. esc$=CHR$(27)
  287. init$=esc$+"#1"
  288. reset$=esc$+"c"
  289. elite$=esc$+"[2w"
  290. eliteaus$=esc$+"[1w"
  291. deutsch$=esc$+"(K"
  292. letter$=esc$+"[2"+CHR$(34)+"z"
  293. letteraus$=esc$+"[1"+CHR$(34)+"z"
  294. fettein$=esc$+"[1m"
  295. fettaus$=esc$+"[22m"
  296. Unterstreichenein$=esc$+"[4m"
  297. Unterstreichenaus$=esc$+"[24m"
  298. normschrift$=esc$+"[0w"  
  299. norm$=esc$+"[0m"
  300. RETURN
  301.